home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CICA Windows Explosion!
/
The CICA Windows Explosion! - Disc 2.iso
/
nt
/
emacssrc.zip
/
EMACSSRC.TAR
/
emacs-19.17
/
lisp
/
dired-nt.el
< prev
next >
Wrap
Lisp/Scheme
|
1993-11-21
|
5KB
|
125 lines
;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Author: Geoff Voelker (voelker@cs.washington.edu)
;; Version: 1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; (August 12, 1993)
;; Functions for finding the file name in a dired buffer line on NT.
;;; Code:
;; Move to first char of filename on this line.
;; Returns position (point) or nil if no filename on this line."
(defun dired-move-to-filename (&optional raise-error eol)
;; This is the UNIX version.
(or eol (setq eol (progn (end-of-line) (point))))
(beginning-of-line)
(if (re-search-forward
"\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
eol t)
(progn
(skip-chars-forward " ") ; there is one SPC after day of month
(skip-chars-forward "^ " eol) ; move after time of day
(skip-chars-forward " " eol) ; there is space before the year
(skip-chars-forward "[0-9]" eol) ; move after year
(skip-chars-forward " " eol) ; there is space before the file name
;; Actually, if the year instead of clock time is displayed,
;; there are (only for some ls programs?) two spaces instead
;; of one before the name.
;; If we could depend on ls inserting exactly one SPC we
;; would not bomb on names _starting_ with SPC.
(save-excursion
;; Find out what kind of file this is: if it's a directory,
;; skip past the "[" that ls placed at the beginning of the
;; filename.
(if (re-search-backward "\\([^ ]\\)[-r][-a][-h][-s]" nil t)
(setq file-type (char-after (match-beginning 1)))
(or raise-error (error "No file on this line"))))
(if (eq file-type '?d)
(skip-chars-forward "[" eol)
nil)
(point))
(if raise-error
(error "No file on this line")
nil)))
(defun dired-move-to-end-of-filename (&optional no-error)
;; Assumes point is at beginning of filename,
;; thus the rwx bit re-search-backward below will succeed in *this*
;; line if at all. So, it should be called only after
;; (dired-move-to-filename t).
;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
;; This is the UNIX version.
(let (opoint file-type executable symlink hidden case-fold-search used-F eol)
;; case-fold-search is nil now, so we can test for capital F:
(setq used-F (string-match "F" dired-actual-switches)
opoint (point)
eol (save-excursion (end-of-line) (point))
hidden (and selective-display
(save-excursion (search-forward "\r" eol t))))
(if hidden
nil
(save-excursion ;; Find out what kind of file this is:
;; Restrict perm bits to be non-blank,
;; otherwise this matches one char to early (looking backward):
;; "l---------" (some systems make symlinks that way)
;; "----------" (plain file with zero perms)
;;
;; "drahs"
(if (re-search-backward
"\\([^ ]\\)[-r][-a][-h][-s]"
;; "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
nil t)
(setq file-type (char-after (match-beginning 1))
symlink nil
;; Only with -F we need to know whether it's an executable
executable nil)
(or no-error (error "No file on this line"))))
;; Move point to end of name:
(if symlink
(if (search-forward " ->" eol t)
(progn
(forward-char -3)
(and used-F
dired-ls-F-marks-symlinks
(eq (preceding-char) ?@);; did ls really mark the link?
(forward-char -1))))
(goto-char eol);; else not a symbolic link
;; ls -lF marks dirs, sockets and executables with exactly one
;; trailing character. (Executable bits on symlinks ain't mean
;; a thing, even to ls, but we know it's not a symlink.)
(and used-F
(or (memq file-type '(?d ?s))
executable)
(forward-char -1))))
(or no-error
(not (eq opoint (point)))
(error (if hidden
(substitute-command-keys
"File line is hidden, type \\[dired-hide-subdir] to unhide")
"No file on this line")))
(if (eq opoint (point))
nil
(if (eq file-type '?d) ; if it's a directory, skip past the "]" at
(forward-char -1) ; the end of the filename
nil))
(point)))